/*
 * Copyright (C) 2008,2009,2010,2011  Paulo Cesar Pereira de Andrade.
 *
 * This is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * Authors:
 *	Paulo Cesar Pereira de Andrade
 */

#include "exl.h"

/*
 * Prototypes
 */
static efunction_t *
make_function(esymbol_t *symbol, ehash_t *parent);

static eint32_t
setup_arguments(eobject_t list, ebool_t method);

static void
eval_arguments(eobject_t list, ebool_t method);

static void
apply_arguments(efunction_t *lambda, eint32_t count);

static ebool_t
side_effects_p(east_list_t *list, east_list_t *stop);

/*
 * Initialization
 */
static evector_t	*function_root;
static evector_t	*function_next;

/*
 * Implementation
 */
void
init_function(void)
{
    eobject_t	*root;

    evector(&function_root, t_void, 8, 1);
    eadd_root((eobject_t *)&function_root);
    root = function_root->v.ptr;

    evector(&function_next, t_void, 8, 1);
    root[0] = function_next;

    function_root->offset = 1;
}

void
finish_function(void)
{
    erem_root((eobject_t *)&function_root);
}

efunction_t *
enew_function(ebool_t define, esymbol_t *name)
{
    esymbol_t	*symbol;

    if (name) {
	symbol = enew_symbol(ht_root, name->name);
	symbol->a_global = true;
	symbol->a_function = true;
	if (define)
	    ereference_function(symbol);
	else
	    /* declaration of never defined functions is not a fatal error */
	    symbol->offset = -1;
    }
    else
	symbol = null;

    return (make_function(symbol, ht_current));
}

efunction_t *
enew_method(eclass_t *record, esymbol_t *name)
{
    eint32_t	 type;
    eint32_t	 count;
    esymbol_t	*symbol;
    efunction_t	*lambda;

    /* if class still "open" */
    if (record->type == t_pointer)
	edef_record(record);
    else if (!(record->type & t_pointer))
	/* actually could define it, but that would break
	 * the inheritance for any already derived class */
	eparse_error(null, "cannot define '%p.%p', class already defined",
		     record->name->name, name->name == symbol_new->name ?
		     record->name->name : name->name);

    type = record->type & ~t_pointer;
    count = record->methods->count;
    symbol = enew_symbol(record->methods, name->name);
    symbol->offset = count;
    symbol->a_method = true;
    symbol->a_ctor = name->name == symbol_new->name;

    lambda = make_function(symbol, record->fields);
    lambda->record = record;

    /* update class method tables */
    if (count == 0) {
	evector(&record->vmethod, t_void, 4, 1);
	enew_object((eobject_t *)&ets[type].methods, t_resize | t_void,
		    4 * sizeof(emethod_t));
    }
    else if ((count & 3) == 0) {
	erenew_vector(record->vmethod, count + 4);
	eresize_object((eobject_t *)&ets[type].methods,
		       sizeof(emethod_t) * (count + 4));
    }
    record->vmethod->v.ptr[count] = symbol;
    ets[type].nmethod = count + 1;
    ets[type].methods[count].type = type;
    ets[type].methods[count].code = symbol;

    return (lambda);
}

efunction_t *
eget_method(eclass_t *record, esymbol_t *name)
{
    efunction_t	*lambda;
    esymbol_t	*symbol;
    efunction_t	*method;

    /* if class still "open" */
    if (record->type == t_pointer)
	edef_record(record);

    symbol = eget_symbol(record->methods, name->name);
#if DEBUG
    if (symbol == null)
	eparse_error(null, "internal error (bad method table)");
#endif

    /* superclass version or already declared */
    method = symbol->value;
    if (method->record == record)
	lambda = symbol->value;
    else if (!(record->type & t_pointer))
	/* class definition block is closed, and the method is now inherited */
	eparse_error(null, "cannot define '%p.%p', class already defined",
		     record->name->name, emethod_name(record, symbol));
    else {
	/* create virtual method */
	lambda = make_function(symbol, record->fields);
	lambda->record = record;

	/* copy common fields */
	lambda->tag = method->tag;
	lambda->args = method->args;
	lambda->voffset = method->voffset;

	/* update class method table */
	ets[record->type & ~t_pointer].methods[symbol->offset].code = symbol;
    }

    return (lambda);
}

void
ereference_function(esymbol_t *symbol)
{
    if (ecs_idx >= ecs_len) {
	assert(ecs_idx <= most_positive_fix32);
	ecs_len += 4096;
	eresize_object((eobject_t *)&ecs, ecs_len * sizeof(eobject_t));
    }
    ecs[ecs_idx] = symbol;
    symbol->offset = ecs_idx++;
}

void
eset_methods(eclass_t *record)
{
    eint32_t	 i;
    eint32_t	 type;
    eclass_t	*super;
    eint32_t	 count;
    esymbol_t	*symbol;
    esymbol_t	*method;

    if (record->type == t_pointer)
	edef_record(record);

    super = record->super;
    if (super && super->methods->count) {
	/* allocate methods hash table */
	enew_hash((eobject_t *)&record->methods,
		  H_pointer, super->methods->size);

	/* copy method symbol table */
	type = record->type & ~t_pointer;
	count = super->methods->count;
	evector(&record->vmethod, t_void, (count + 3) & -3, 1);
	enew_object((eobject_t *)&ets[type].methods, t_resize | t_void,
		    sizeof(emethod_t) * ((count + 3) & - 3));

	for (i = 0; i < count; i++) {
	    symbol = super->vmethod->v.ptr[i];
	    method = enew_symbol(record->methods, symbol->name);
	    record->vmethod->v.ptr[i] = method;
	    method->tag = symbol->tag;
	    method->value = symbol->value;
	    method->offset = symbol->offset;
	    method->a_method = true;
	    method->a_ctor = symbol->a_ctor;
	    ets[type].methods[i] = ets[super->type].methods[i];
	}
	ets[type].nmethod = count;
    }
    else
	enew_hash((eobject_t *)&record->methods, H_pointer, 5);
}

#if !JITVM
void
efinalize_functions(void)
{
    eint32_t	 i;
    efunction_t	*lambda;
    esymbol_t	*symbol;

    ecs[0] = fn_root->code;
    for (i = 1; i < ecs_idx; i++) {
	symbol = ecs[i];
	lambda = symbol->value;
	if (!efunction_p(lambda) || !lambda->defined)
	    eerror("function '%p' not defined", symbol->name);
	ecs[i] = lambda->code;
	lambda->code = null;
    }
}

void
efinalize_methods(void)
{
    eint32_t	 i;
    eint32_t	 j;
    eint32_t	 count;
    efunction_t	*lambda;
    eclass_t	*record;
    esymbol_t	*symbol;

    /* first pass - check for errors */
    for (i = 0; i < ets_idx; i++) {
	record = record_vector[i];
	assert(i == (record->type & ~t_pointer));
	if (record->methods && record->methods->count) {
	    count = record->methods->count;
	    for (j = 0; j < count; j++) {
		symbol = ets[i].methods[j].code;
		lambda = symbol->value;
		if (!efunction_p(lambda) || !lambda->defined)
		    eerror("method '%p.%p' not defined",
			   record->name->name, emethod_name(record, symbol));
		ets[i].methods[j].code = lambda->code;
	    }
	}
    }

    /* second pass - release methods memory */
    for (i = 0; i < ets_idx; i++) {
	record = record_vector[i];
	if (record->methods) {
	    for (j = record->methods->count - 1; j >= 0; j--) {
		symbol = record->vmethod->v.ptr[j];
		lambda = symbol->value;
		lambda->code = null;
	    }
	}
    }
}
#endif

void
efinalize_function(efunction_t *lambda)
{
    eobject_t	 cons;
    eblock_t	*block;
    eentry_t	*entry;
    esymbol_t	*symbol;
    eobject_t	 object;
    eblock_t	*gblock;
    eblock_t	*lblock;

    /* check for invalid gotos */
    for (object = lambda->gotos; object; object = ecdr(object)) {
	cons = ecar(object);
	symbol = ecar(cons);
	gblock = ecdr(cons);
	if ((entry = eget_hash(lambda->table, symbol)) == null)
	    eparse_error(null, "undefined label '%p'", symbol->name);
	lblock = ecdr(entry->value);

	for (block = gblock; block; block = block->parent) {
	    if (block == lblock)
		goto done;
	}
	for (block = lblock; block; block = block->parent) {
	    if (block == gblock)
		goto done;
	}

	/* report error */
	for (block = lblock; block; block = block->parent) {
	    if (block->token == tok_try || block->token == tok_catch)
		eparse_error(null, "'goto %p', inside '%s' is not allowed",
			     symbol->name,
			     block->token == tok_try ? "try" : "catch");
	}
	for (block = gblock; block; block = block->parent) {
	    if (block->token == tok_try || block->token == tok_catch)
		eparse_error(null, "'goto %p', leaving '%s' is not allowed",
			     symbol->name,
			     block->token == tok_try ? "try" : "catch");
	}

    done:
	;
    }

    /* no longer required */
    lambda->gotos = null;
    lambda->table = null;

    lambda->defined = true;
}

etag_t *
eapply_function(esymbol_t *symbol, eobject_t list)
{
    eint32_t	 count;
    efunction_t	*lambda;

    lambda = symbol->value;
    if (!efunction_p(lambda))
	eparse_error(null, "'%p' is not a function", symbol->name);

    count = setup_arguments(list, false);
    if (count < lambda->args)
	eparse_error(null, "too few arguments to '%p'", symbol->name);
    else if (!lambda->voffset && count > lambda->args)
	eparse_error(null, "too many arguments to '%p'", symbol->name);
    eval_arguments(list, false);

    apply_arguments(lambda, count);

    if (symbol->offset < 0)
	ereference_function(symbol);
    if (symbol->a_builtin)
	east_link(ecode_builtin(symbol, count));
    else {
	if (lambda->voffset) {
	    count -= lambda->args;
	    east_link(ecode_vararg(eop_vas, count));
	}
	east_link(ecode_call(symbol));

	/* restore stack */
	if (lambda->voffset)
	    east_link(ecode_vararg(eop_val, count));
    }

    return (symbol->tag);
}

etag_t *
eapply_reference(eobject_t object, eobject_t list)
{
    etag_t	*tag;
    eint32_t	 count;
    esymbol_t	*symbol;

    count = setup_arguments(list, false);
    eval_arguments(list, false);
    apply_arguments(null, count);

    tag = eeval(object);
    /* checking for symbol->a_function because if it is
     * actually a function and not a function reference,
     * the function should be called directly, but could
     * be rearranged here... */
    symbol = object;
    if ((esymbol_p(symbol) && symbol->a_function) ||
	tag == null || tag->type != tag_function) {
	if (esymbol_p(symbol))
	    eparse_error(null, "'%p' is not a function reference",
			 symbol->name);
	eparse_error(null, "object is not a function reference");
    }
    east_link(ecode_apply(count));
    east_link(ecode_simple(eop_aret));

    return (*(eobject_t *)tag->data);
}

etag_t *
eapply_method(ebool_t explicit, eobject_t object,
	      esymbol_t *symbol, eobject_t list)
{
    etag_t	*tag;
    ecode_t	 code;
    eint32_t	 type;
    eint32_t	 count;
    eint32_t	 offset;
    efunction_t	*lambda;
    erecord_t	*record;

    count = setup_arguments(list, true);

    if (object == this_obj) {
	record = fn_current->record;
#if DEBUG
	if (record == null)
	    eparse_error(null, "internal error (invalid 'this' pointer)");
#endif
	east_link(ecode_symbol_load(eget_symbol(fn_current->hash,
						symbol_this->name)));
    }
    else {
	if (etag_p(object)) {
	    tag = object;
	    if (!explicit) {
		/* if pointer not already on stack,
		 * must be from within a class method,
		 * or there will be no `this' pointer */
		if (fn_current->record == null)
		    eparse_error(null, "syntax error");
		explicit = true;
		east_link(ecode_symbol_load(eget_symbol(fn_current->hash,
							symbol_this->name)));
	    }
	}
	else
	    tag = eeval(object);
	if (tag == null || tag->type != tag_class)
	    eparse_error(null, "object is not a method");
	record = tag->data;
    }
    if (!esymbol_p(symbol))
	eparse_error(null, "object is not a method");
    object = eget_symbol(record->methods, symbol->name);
    if (object == null)
	eparse_error(null, "'%p' doesn't have a '%p' method",
		     record->name->name, emethod_name(record, symbol));
    symbol = object;
    lambda = symbol->value;

    if (count < lambda->args)
	eparse_error(null, "too few arguments to '%p.%p'",
		     record->name->name, emethod_name(record, symbol));
    else if (!lambda->voffset && count > lambda->args)
	eparse_error(null, "too many arguments to '%p.%p'",
		     record->name->name, emethod_name(record, symbol));

    eval_arguments(list, true);
    apply_arguments(lambda, count);

    offset = symbol->offset;

    /* generate method call opcode */
    if (explicit) {
	if (fn_current->record == record)
	    /* warn about possible typo */
	    eparse_warn(null, "explicit call to '%p.%p' is recursive",
			record->name->name, emethod_name(record, symbol));
	type = record->type & ~t_pointer;
	code = eop_ecm;
    }
    else {
	type = ets[record->type & ~t_pointer].methods[offset].type;
	code = eop_meth;
    }

    if (lambda->voffset) {
	count -= lambda->args;
	east_link(ecode_vararg(eop_vas, count));
    }

    east_link(ecode_method(code, symbol, type));

    /* restore stack */
    if (lambda->voffset)
	east_link(ecode_vararg(eop_val, count));

    return (symbol->tag);
}

static efunction_t *
make_function(esymbol_t *symbol, ehash_t *parent)
{
    elabel_t		*label;
    efunction_t		*lambda;

    v_check(1);
    enew(&lambda, function);
    v_push(lambda);
    if (symbol) {
	lambda->name = symbol;
	symbol->value = lambda;
    }

    /* function arguments and local variables */
    enew_hash((eobject_t *)&lambda->hash, H_string, 5);

    /* label table */
    evector(&lambda->labels, t_void, 8, 1);

    /* user defined labels */
    enew_hash((eobject_t *)&lambda->table, H_pointer, 5);

    /* symbol load information */
    evector(&lambda->loads, t_void, 8, 1);

    /* symbol store information */
    evector(&lambda->stores, t_void, 8, 1);

    /* symbol to bit offset */
    enew_hash((eobject_t *)&lambda->hsym, H_pointer, 5);

    /* bit offset to symbol */
    evector(&lambda->vsym, t_void, 8, 1);

    /* bitmask of symbols with aggregate access */
    enew_mpz_u((eobject_t *)&lambda->esc, 0);

    /* bitmask of symbols with address taken */
    enew_mpz_u((eobject_t *)&lambda->ptr, 0);

    /* bitmask of symbols set */
    enew_mpz_u((eobject_t *)&lambda->set, 0);

    /* functions information */
    enew_hash((eobject_t *)&lambda->functions, H_pointer, 5);

    lambda->hash->parent = parent;
    if (fn_root)
	/* local variables start at offset 1, and arguments at offset -2 */
	lambda->hash->offset = 1;
    /* 0 should be a valid offset for the root function */
    lambda->tryoff = -1;

    /* initialize code representation */
    label = ecreate_label(lambda);
    lambda->code = lambda->tail = east_label_no_link(ecode_block(label));
    east_next(lambda->code) = lambda->tail = east_no_link(ecode_enter_init());

    v_dec();

    return (lambda);
}

static eint32_t
setup_arguments(eobject_t list, ebool_t method)
{
    eint32_t	 length;
    evector_t	*vector;
    eobject_t	*pointer;

    if (function_root->offset >= function_root->length)
	erenew_vector(function_root, function_root->length + 8);
    pointer = function_root->v.ptr;

    /* setup vector to remember arguments */
    length = elength(list) + !!method + 1;
    vector = pointer[function_root->offset];
    if (vector == null) {
	evector((evector_t **)(pointer + function_root->offset),
		t_void, (length + 8) & ~7, 1);
	vector = pointer[function_root->offset];
    }
    else if (vector->length <= length)
	erenew_vector(vector, (length + 8) & ~7);
    ++function_root->offset;

    /* remember current start of code */
    pointer = vector->v.ptr;
    pointer[0] = east_tail();

    /* number of arguments that will be used */
    return (length - 1);
}

static void
eval_arguments(eobject_t list, ebool_t method)
{
    eint32_t	 offset;
    evector_t	*vector;
    eobject_t	*pointer;

    offset = 1;
    pointer = function_root->v.ptr;
    vector = pointer[function_root->offset - 1];
    pointer = vector->v.ptr;
    if (method)
	pointer[offset++] = east_tail();

    for (; list; list = ecdr(list)) {
	/* generate code to evaluate argument */
	eeval(ecar(list));
	/* remember end of evaluated argument */
	pointer[offset++] = east_tail();
    }
}

static void
apply_arguments(efunction_t *lambda, eint32_t count)
{
    etag_t		 *tag;
    east_list_t		 *list;
    east_node_t		 *node;
    etag_t		**tags;
    eint32_t		  ntags;
    eint32_t		  index;
    ebool_t		  value;
    eint32_t		  length;
    eint32_t		  offset;
    ebool_t		  method;
    evector_t		 *vector;
    east_list_t		**pointer;
    evector_t		 *next_vector;
    east_list_t		**next_pointer;

    if (count == 0) {
	--function_root->offset;
	return;
    }

    pointer = function_root->v.obj;
    next_vector = (evector_t *)pointer[0];
    next_pointer = next_vector->v.obj;
    vector = (evector_t *)pointer[function_root->offset - 1];
    pointer = vector->v.obj;
    tags = null;
    value = true;
    method = false;
    if (lambda) {
	method = lambda->record != null;
	if (lambda->name && !lambda->name->a_builtin)
	    /* 'this' tag is not added to tag vector */
	    tags = ((etag_t **)lambda->tag->data) + !method;
	else
	    value = false;
	ntags = lambda->args - method;
    }
    else
	ntags = 0;

    /* non side effects arguments can be pushed in reversed order, that
     * is easier, and doesn't require pre allocating stack space */
    for (length = 0; length < count; length++)
	if (side_effects_p(pointer[length], pointer[length + 1]))
	    break;

    /* doesn't matter if first left to right argument has side effects */
    if (length == 0)
	length = 1;

    if (next_vector->length <= length) {
	erenew_vector(next_vector, (length + 8) & ~7);
	next_pointer = next_vector->v.obj;
    }
    for (offset = 0; offset <= length; offset++) {
	if ((index = offset - 2) < 0)
	    index += length + 1;
	next_pointer[offset] = east_next(pointer[index]);
    }
    for (offset = length; offset > 0; offset--) {
	index = offset - 1;
	tag = tags && index < ntags && (!method || index) ? tags[index] : null;
	node = value ? ecode_push_value_tag(tag) : ecode_push_tag(tag);
	list = east_no_link(node);
	east_next(list) = next_pointer[offset];
	east_next(pointer[offset]) = list;
    }
    if (length < count) {
	node = ecode_vararg(eop_begin, count - length);
	list = east_no_link(node);
	east_next(list) = next_pointer[0];
	east_next(pointer[0]) = list;
	for (offset = length + 1; offset <= count; offset++) {
	    /* 'this' tag is not added to tag vector */
	    tag = tags && offset <= ntags ? tags[offset - 1] : null;
	    if (value)
		node = ecode_stack_store_value_tag(-offset, tag);
	    else
		node = ecode_stack_store_tag(-offset, tag);
	    list = east_no_link(node);
	    /* prepend store before the entry after the argument */
	    east_next(list) = east_next(pointer[offset]);
	    east_next(pointer[offset]) = list;
	}
	east_tail() = east_next(pointer[count]);
	/* 'this' was not the last evaluated argument */
	if (method)
	    east_link(ecode_stack_load(-1));

    }
    else {
	if (count > 1)
	    east_next(pointer[0]) = next_pointer[0];
	east_tail() = east_next(pointer[1]);
    }
    --function_root->offset;
}

/* check for side effects opcodes that prevent right to left evaluation
 * of arguments */
static ebool_t
side_effects_p(east_list_t *list, east_list_t *stop)
{
    east_node_t		*node;

    for (; list != stop; list = east_next(list)) {
	node = east_node(list);
	switch (node->code) {
	    case eop_sd:			case eop_sdt:
	    case eop_sb:			case eop_sbt:
	    case eop_sh:			case eop_shref:
	    case eop_sv:			case eop_svi:
	    case eop_svref:			case eop_sr:
	    case eop_srref:			case eop_sc:
	    case eop_sref:			case eop_call:
	    case eop_meth:			case eop_ecm:
	    case eop_blt:			case eop_apply:
	    case eop_sva:			case eop_svai:
		/* stop earlier if a function call with side effects follow
		 * or other kind of side effect operations */
	    case eop_begin:			case eop_pushv:
		return (true);
	    default:
		break;
	}
    }

    return (false);
}
